#include "Col.ph"

#include "Class.h"
#include "System.h"
#include "String.h"
#include "Env.h"
#include "Interpreter.h"

#include "ET_stdio.h"
#include "ET_tcl.h"

//---- TclInt ------------------------------------------------------------------

class TclInt : public InterpreterImpl {
public:
	MetaDef(TclInt);
	TclInt()
		{ }
	~TclInt();
	void InitNew();

	int Eval(const char *command);
	void SetResult(const char *str, bool makecopy= TRUE);
	const char *GetResult();

	int InstallCommand(const char *cmdname, IntCmdProc *proc, void *clientdata);
	int LoadSourceFile(const char *fname);

protected:
	Tcl_Interp *interp;
};

//---- TclClientData -----------------------------------------------------------

struct TclClientData {
public:
	TclClientData(TclInt *ip, IntCmdProc *p, void *cd);
	virtual ~TclClientData();
	static int TclCommand(TclClientData*, Tcl_Interp*, int, char*[]);
	static void TclDeleteProc(TclClientData*);
protected:
	TclInt *interp;
	void *clientdata;
	IntCmdProc *proc;
};

TclClientData::TclClientData(TclInt *ip, IntCmdProc *p, void *cd)
					: interp(ip), proc(p), clientdata(cd)
{
}

TclClientData::~TclClientData()
{
}

int TclClientData::TclCommand(TclClientData *cld, Tcl_Interp*, int argc, char *argv[])
{
	return cld->proc(cld->clientdata, cld->interp->GetInterpreter(), argc, argv) == 0
		? TCL_OK
		: TCL_ERROR;
}

void TclClientData::TclDeleteProc(TclClientData *cld)
{
	SafeDelete(cld);
}

//---- TclInt ------------------------------------------------------------------

NewMetaImpl0(TclInt,InterpreterImpl);

TclInt::~TclInt()
{
	if (interp) {
		Tcl_DeleteInterp(interp);
		interp= 0;
	}
}

void TclInt::InitNew()
{
	InterpreterImpl::InitNew();
	interp= Tcl_CreateInterp();
}

int TclInt::Eval(const char *command)
{
	if (Env::GetValue("Tcl.Debug", 0))
		fprintf(stderr,"TclInt::Eval: %s\n", command);
#if TCL_MAJOR_VERSION < 7
	if (Tcl_Eval(interp, (char*)command, 0, 0) == TCL_ERROR)
#else
	if (Tcl_Eval(interp, (char*)command) == TCL_ERROR)
#endif
		return -1;
	return 0;
}

const char *TclInt::GetResult()
{
	return interp->result;
}

void TclInt::SetResult(const char *str, bool makecopy)
{
	Tcl_SetResult(interp, (char*)str, makecopy ? TCL_VOLATILE : TCL_STATIC);
}

int TclInt::InstallCommand(const char *cmdname, IntCmdProc *proc, void *clientdata)
{
	Tcl_CreateCommand(interp,
		(char*)cmdname,
		(Tcl_CmdProc*)TclClientData::TclCommand,
		(int*)new TclClientData(this, proc, clientdata),
		(Tcl_CmdDeleteProc*)TclClientData::TclDeleteProc);
	return 0;
}

int TclInt::LoadSourceFile(const char *fname)
{
	char buf[400];
	strcpy(buf, fname);
	gSystem->ExpandPathName(buf, sizeof(buf)-1);
	return Tcl_EvalFile(interp, buf);
}

